home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / MoDE / ITLibrary-Shan.st < prev    next >
Text File  |  1993-07-24  |  6KB  |  272 lines
  1. OpaqueController1 subclass: #PushButtonController
  2.     instanceVariableNames: ''
  3.     classVariableNames: 'PushButtonControllerERD '
  4.     poolDictionaries: ''
  5.     category: 'ITLibrary-Shan'!
  6.  
  7.  
  8. !PushButtonController methodsFor: 'sharedBehavior-action'!
  9.  
  10. actionLoop
  11.     "Shan August 16, 1989"
  12.  
  13.     | eq |
  14.     mode highlight.
  15.     eq _ self eventQueue.  "Shan 13 July 1990"
  16.     [(event _ eq next) selector ~= #leftButtonUp]
  17.         whileTrue: 
  18.             [(mode containsPoint: event origin)
  19.                 & (mode containsPoint: event previousOrigin) not ifTrue: [mode highlight].
  20.             (mode containsPoint: event origin) not & (mode containsPoint: event previousOrigin) ifTrue: [mode deHighlight]].
  21.     (mode containsPoint: event origin)
  22.         ifTrue: 
  23.             [mode deHighlight.
  24.             semObj perform: #action: with: event].
  25.     ^true! !
  26. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  27.  
  28. PushButtonController class
  29.     instanceVariableNames: ''!
  30.  
  31.  
  32. !PushButtonController class methodsFor: 'access'!
  33.  
  34. eventResponsesDict
  35.     ^ PushButtonControllerERD! !
  36.  
  37. !PushButtonController class methodsFor: 'initialize'!
  38.  
  39. ERDinit
  40.  
  41.     PushButtonControllerERD _ super eventResponsesDict deepCopy.
  42.     PushButtonControllerERD at: #leftButtonDown put: #actionLoop.! !
  43.  
  44. SemanticObject subclass: #TextLabel
  45.     instanceVariableNames: 'text fixedSize '
  46.     classVariableNames: ''
  47.     poolDictionaries: ''
  48.     category: 'ITLibrary-Shan'!
  49. TextLabel comment:
  50. 'The inst var ''text'' can store String, DisplayText, and Paragraph.  Shan July 31, 1989'!
  51.  
  52.  
  53. !TextLabel methodsFor: 'control'!
  54.  
  55. fixedSize
  56.     "Shan August 4, 1989"
  57.  
  58.     ^fixedSize!
  59.  
  60. fixedSize: aBool
  61.     "Shan August 4, 1989"
  62.  
  63.     fixedSize _ aBool! !
  64.  
  65. !TextLabel methodsFor: 'displaying'!
  66.  
  67. displayText: aText 
  68.     "text can be string or subclass of DisplayText.  Shan August 4, 1989"
  69.  
  70.     self text: aText.
  71.     mode erase.
  72.     mode display! !
  73.  
  74. !TextLabel methodsFor: 'private'!
  75.  
  76. text: aStringOrDisplayText borderWidth: w 
  77.     "Shan December 3, 1989"
  78.  
  79.     mode borderWidth: w.    "Set the bordreW before placing the text, so that relative position 
  80.     can be calculated."
  81.     self text: aStringOrDisplayText! !
  82.  
  83. !TextLabel methodsFor: 'access'!
  84.  
  85. checkSize
  86.     "If resizable, resize when the text is changed.  Shan August 4, 1989"
  87.  
  88.     fixedSize ifFalse: [mode resizeToFitDisplayObject]!
  89.  
  90. displayText
  91.     ^text asDisplayText!
  92.  
  93. string
  94.     ^text asString!
  95.  
  96. text: aStringOrDisplayText
  97.     "Shan August 4, 1989"
  98.  
  99.     text _ aStringOrDisplayText.
  100.     mode displayObject clear.
  101.     mode displayObject relAdd: aStringOrDisplayText asDisplayText.
  102.     self checkSize! !
  103.  
  104. !TextLabel methodsFor: 'initialize-release'!
  105.  
  106. initialize
  107.     "Shan August 4, 1989"
  108.  
  109.     super initialize.
  110.     fixedSize _ false! !
  111.  
  112. !TextLabel methodsFor: 'attribute editor'!
  113.  
  114. editAttributes
  115.     "Shan August 25, 1989"
  116.  
  117.     | name |
  118.     self eventQueue disable.
  119.     name _ FillInTheBlank request: 'Enter a new label.'.
  120.     self eventQueue enable.
  121.     self text: name! !
  122. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  123.  
  124. TextLabel class
  125.     instanceVariableNames: ''!
  126.  
  127.  
  128. !TextLabel class methodsFor: 'instance creation'!
  129.  
  130. text: aStringOrDisplayText 
  131.     "I can accept a string or any subclass of DisplayText.  Shan December 3, 
  132.     1989 "
  133.  
  134.     ^self text: aStringOrDisplayText borderWidth: 0!
  135.  
  136. text: aStringOrDisplayText borderWidth: w
  137.     "Shan December 3, 1989 "
  138.  
  139.     ^self new text: aStringOrDisplayText borderWidth: w! !
  140.  
  141. TextLabel subclass: #TextButton
  142.     instanceVariableNames: 'actionMessage '
  143.     classVariableNames: ''
  144.     poolDictionaries: ''
  145.     category: 'ITLibrary-Shan'!
  146.  
  147.  
  148. !TextButton methodsFor: 'initialize-release'!
  149.  
  150. initialize
  151.     "Shan September 2, 1989"
  152.  
  153.     super initialize.
  154.     actionMessage _ #buttonPushed:! !
  155.  
  156. !TextButton methodsFor: 'controller-msg'!
  157.  
  158. action: e 
  159.     "Shan September 2, 1989"
  160.  
  161.     target1 notNil ifTrue: [target1 perform: actionMessage with: self string]! !
  162.  
  163. !TextButton methodsFor: 'MMS-initializations'!
  164.  
  165. defaultMMSControllerClass
  166.     "Shan August 16, 1989"
  167.  
  168.     ^PushButtonController!
  169.  
  170. setUpAppearance
  171.     "Shan August 16, 1989"
  172.  
  173.     mode highlightDispObj: #inverseHighlight! !
  174.  
  175. !TextButton methodsFor: 'access'!
  176.  
  177. actionMessage
  178.     "Shan August 16, 1989"
  179.  
  180.     ^actionMessage!
  181.  
  182. actionMessage: aMsgSelector
  183.     "Shan August 16, 1989"
  184.  
  185.     actionMessage _ aMsgSelector! !
  186.  
  187. OpaqueController1 subclass: #MidMenuController
  188.     instanceVariableNames: ''
  189.     classVariableNames: 'MidMenuControllerERD '
  190.     poolDictionaries: ''
  191.     category: 'ITLibrary-Shan'!
  192.  
  193. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  194.  
  195. MidMenuController class
  196.     instanceVariableNames: ''!
  197.  
  198.  
  199. !MidMenuController class methodsFor: 'access'!
  200.  
  201. eventResponsesDict
  202.     ^MidMenuControllerERD! !
  203.  
  204. !MidMenuController class methodsFor: 'initialize'!
  205.  
  206. ERDinit
  207.     "Shan 29 May 1990"
  208.  
  209.     MidMenuControllerERD _ super eventResponsesDict deepCopy.
  210.     MidMenuControllerERD at: #middleButtonDown put: #expandMiddleMenu! !
  211.  
  212. MidMenuController subclass: #MidMenuDoubleclickController
  213.     instanceVariableNames: ''
  214.     classVariableNames: 'MidMenuDoubleclickControllerERD '
  215.     poolDictionaries: ''
  216.     category: 'ITLibrary-Shan'!
  217.  
  218.  
  219. MidMenuController subclass: #MidMenuDoubleClickController
  220.     instanceVariableNames: ''
  221.     classVariableNames: 'MidMenuDoubleClickControllerERD '
  222.     poolDictionaries: ''
  223.     category: 'ITLibrary-Shan'!
  224.  
  225. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  226.  
  227. MidMenuDoubleClickController class
  228.     instanceVariableNames: ''!
  229.  
  230.  
  231. !MidMenuDoubleClickController class methodsFor: 'initialize'!
  232.  
  233. ERDinit
  234.     "Shan 14 June 1990"
  235.  
  236.     MidMenuDoubleClickControllerERD _ super eventResponsesDict deepCopy.
  237.     MidMenuDoubleClickControllerERD at: #leftButtonDoubleClick put: #action:! !
  238.  
  239. !MidMenuDoubleClickController class methodsFor: 'access'!
  240.  
  241. eventResponsesDict
  242.     "Shan 14 June 1990"
  243.  
  244.     ^MidMenuDoubleClickControllerERD! !
  245.  
  246. MidMenuController subclass: #MidMenuHighlightController
  247.     instanceVariableNames: ''
  248.     classVariableNames: 'MidMenuHighlightControllerERD '
  249.     poolDictionaries: ''
  250.     category: 'ITLibrary-Shan'!
  251.  
  252. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  253.  
  254. MidMenuHighlightController class
  255.     instanceVariableNames: ''!
  256.  
  257.  
  258. !MidMenuHighlightController class methodsFor: 'access'!
  259.  
  260. eventResponsesDict
  261.     "Shan 29 May 1990"
  262.  
  263.     ^MidMenuHighlightControllerERD! !
  264.  
  265. !MidMenuHighlightController class methodsFor: 'initialize'!
  266.  
  267. ERDinit
  268.     "Shan 29 May 1990"
  269.  
  270.     MidMenuHighlightControllerERD _ super eventResponsesDict deepCopy.
  271.     MidMenuHighlightControllerERD at: #enterMode put: #highlight.
  272.     MidMenuHighlightControllerERD at: #leaveMode put: #deHighlight! !